home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue27 / collate / COLLSTRL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-09-02  |  7.7 KB  |  243 lines
  1. (********************************************************************)
  2. (* CollStrL.PAS                                                     *)
  3. (* Sorted String List class that uses collation tables              *)
  4. (*                                                                  *)
  5. (* (c) Julian M Bucknall, 1997                                      *)
  6. (********************************************************************)
  7.  
  8. { Notes:
  9.   The TCollStringList class is an example of how to use the collation
  10.   class from the COLLATE unit.
  11.  
  12.   Internally the string list maintains for each item a string, an
  13.   object reference and a sort string. The sort string is maintained
  14.   by the class for each string and is used for rapid searching through
  15.   the items in the list (see the Find method).
  16.  
  17.   Some brief documentation (it pays to know what Delphi's TStringList
  18.   can do, this class mimics it to a certain extent):
  19.  
  20.     constructor Create(aCollFileName : string);
  21.     - creates an instance of the sorted list, aCollFileName is the
  22.       name of a collation table file. It internally creates a
  23.       TCollation object.
  24.  
  25.     destructor Destroy;
  26.     - destroys the instance, releasing all memory back to the heap.
  27.  
  28.     function Add(const aSt : string) : integer;
  29.     - adds a string to the list. The integer result is the index of
  30.       the newly added string. If a string already exists in the list
  31.       that compares equal to this one an ECollStringList exception is
  32.       raised.
  33.  
  34.     procedure Delete(aIndex : integer);
  35.     - deletes a string from the list. Any object associated with the
  36.       string is NOT freed. If the index passed is out of range an
  37.       ECollStringList exception is raised.
  38.  
  39.     function Find(const aSt : string; var aIndex : integer) : boolean;
  40.     - finds a string in the list. If found, aIndex is its index and
  41.       the function result is true. If not found, aIndex is the index
  42.       at which the string should be inserted and the function result
  43.       is false.
  44.  
  45.     property Count : integer
  46.     - a read-only property for the number of strings in the list.
  47.  
  48.     property Strings [aIndex : integer] : string
  49.     - a read-only array property that enables you to treat the string
  50.       list as a string array. It's the default array property. If the
  51.       index passed is out of range an ECollStringList exception is
  52.       raised.
  53.  
  54.     property Objects [aIndex : integer] : TObject
  55.     - an array property that enables you to associate an object with
  56.       each string in the list. If the index passed is out of range an
  57.       ECollStringList exception is raised.
  58.  
  59.   It has various limitations, which can be fairly easily solved:
  60.     - there can be no duplicate strings in the list (ie, strings added
  61.       which the collation class reports as equal to strings in the
  62.       list are rejected);
  63.     - the list is always sorted, unlike TStringList you cannot
  64.       maintain the list in an unsorted order;
  65.     - the algorithm for growing the list is very simplistic: the list
  66.       is grown by 32 elements whenever needed. Memory for the internal
  67.       array is only released with Destroy;
  68.     - no method is provided to replace the collation object and to
  69.       re-sort the list.
  70. }
  71.  
  72. unit CollStrL;
  73.  
  74. interface
  75.  
  76. uses
  77.   SysUtils,
  78.   Collate;
  79.  
  80. type
  81.   ECollStringList = class(Exception);
  82.  
  83. type
  84.   TCollStrItem = packed record
  85.     csiStr : string;
  86.     csiSS  : TSortString;
  87.     csiObj : TObject;
  88.   end;
  89.  
  90.   PCollStrArray = ^TCollStrArray;
  91.   TCollStrArray = array [0..pred(MaxInt div sizeof(TCollStrItem))]
  92.                   of TCollStrItem;
  93.  
  94. type
  95.   TCollStringList = class
  96.     protected {private}
  97.       FCollation : TCollation;
  98.       FList      : PCollStrArray;
  99.       FListSize  : integer;
  100.       FListCount : integer;
  101.     protected
  102.       function GetObject(aIndex : integer) : TObject;
  103.       function GetString(aIndex : integer) : string;
  104.       procedure SetObject(aIndex : integer; aObj : TObject);
  105.  
  106.       procedure Grow;
  107.     public
  108.       constructor Create(aCollFileName : string);
  109.       destructor Destroy; override;
  110.       function Add(const aSt : string) : integer;
  111.       procedure Delete(aIndex : integer);
  112.       function Find(const aSt : string; var aIndex : integer) : boolean;
  113.  
  114.       property Count : integer
  115.          read FListCount;
  116.       property Strings [aIndex : integer] : string
  117.          read GetString; default;
  118.       property Objects [aIndex : integer] : TObject
  119.          read GetObject write SetObject;
  120.   end;
  121.  
  122. implementation
  123.  
  124. const
  125.   ListDelta = 32;
  126.  
  127. {===TCollStringList==================================================}
  128. constructor TCollStringList.Create(aCollFileName : string);
  129. begin
  130.   inherited Create;
  131.   FCollation := TCollation.Create;
  132.   FCollation.LoadFromFile(aCollFileName);
  133.   Grow;
  134. end;
  135. {--------}
  136. destructor TCollStringList.Destroy;
  137. begin
  138.   FreeMem(FList, FListSize * sizeof(TCollStrItem));
  139.   FCollation.Free;
  140.   inherited Destroy;
  141. end;
  142. {--------}
  143. function TCollStringList.Add(const aSt : string) : integer;
  144. begin
  145.   if Find(aSt, Result) then
  146.     raise ECollStringList.Create('TCollStringList: Duplicate string');
  147.   if (FListSize = Count) then
  148.     Grow;
  149.   if (Result < Count) then
  150.     Move(FList^[Result],
  151.          FList^[succ(Result)],
  152.          (Count - Result) * sizeof(TCollStrItem));
  153.   inc(FListCount);
  154.   Initialize(FList^[Result]);
  155.   FList^[Result].csiStr := aSt;
  156.   FList^[Result].csiSS := FCollation.ConvertText(aSt);
  157. end;
  158. {--------}
  159. procedure TCollStringList.Delete(aIndex : integer);
  160. begin
  161.   if not ((0 <= aIndex) and (aIndex < Count)) then
  162.     raise ECollStringList.Create('TCollStringList: Index out of bounds');
  163.   Finalize(FList^[aIndex]);
  164.   FList^[aIndex].csiSS.Free;
  165.   dec(FListCount);
  166.   if (aIndex < Count) then
  167.     Move(FList^[succ(aIndex)],
  168.          FList^[aIndex],
  169.          (Count - aIndex) * sizeof(TCollStrItem));
  170. end;
  171. {--------}
  172. function TCollStringList.Find(const aSt : string; var aIndex : integer) : boolean;
  173. var
  174.   SS         : TSortString;
  175.   L, R, M    : integer;
  176.   CompResult : integer;
  177. begin
  178.   Result := false;
  179.   if Count = 0 then begin
  180.     aIndex := 0;
  181.     Exit;
  182.   end;
  183.   SS := FCollation.ConvertText(aSt);
  184.   try
  185.     L := 0;
  186.     R := pred(Count);
  187.     repeat
  188.       M := (L + R) div 2;
  189.       CompResult :=
  190.          FCollation.CompareSortStrings(FList^[M].csiSS, SS);
  191.       if CompResult < 0 then
  192.         L := succ(M)
  193.       else if CompResult > 0 then
  194.         R := pred(M)
  195.       else {strings are equal} begin
  196.         Result := true;
  197.         aIndex := M;
  198.         Exit;
  199.       end;
  200.     until (L > R);
  201.     aIndex := L;
  202.   finally
  203.     SS.Free;
  204.   end;{try..finally}
  205. end;
  206. {--------}
  207. function TCollStringList.GetObject(aIndex : integer) : TObject;
  208. begin
  209.   if not ((0 <= aIndex) and (aIndex < Count)) then
  210.     raise ECollStringList.Create('TCollStringList: Index out of bounds');
  211.   Result := FList^[aIndex].csiObj;
  212. end;
  213. {--------}
  214. function TCollStringList.GetString(aIndex : integer) : string;
  215. begin
  216.   if not ((0 <= aIndex) and (aIndex < Count)) then
  217.     raise ECollStringList.Create('TCollStringList: Index out of bounds');
  218.   Result := FList^[aIndex].csiStr;
  219. end;
  220. {--------}
  221. procedure TCollStringList.SetObject(aIndex : integer; aObj : TObject);
  222. begin
  223.   if not ((0 <= aIndex) and (aIndex < Count)) then
  224.     raise ECollStringList.Create('TCollStringList: Index out of bounds');
  225.   FList^[aIndex].csiObj := aObj;
  226. end;
  227. {--------}
  228. procedure TCollStringList.Grow;
  229. begin
  230.   if (FList = nil) then begin
  231.     GetMem(FList, ListDelta * sizeof(TCollStrItem));
  232.     FListSize := ListDelta;
  233.     FListCount := 0;
  234.   end
  235.   else {list already exists} begin
  236.     ReallocMem(FList, (FListSize + ListDelta) * sizeof(TCollStrItem));
  237.     inc(FListSize, ListDelta);
  238.   end;
  239. end;
  240. {====================================================================}
  241.  
  242. end.
  243.